PC Users 1999 April/Cd Pc Users extra 19 abril 1999.iso/Prog/Inst/Cipher/FORM1.FRM

Visual Basic Form | 1998-08-17 | 5.4 KB | 183 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   2655
   ClientLeft      =   1140
   ClientTop       =   1515
   ClientWidth     =   8775
   Height          =   3060
   Left            =   1080
   LinkTopic       =   "Form1"
   ScaleHeight     =   2655
   ScaleWidth      =   8775
   Top             =   1170
   Width           =   8895
   Begin VB.CommandButton cmdDecipher
      Caption         =   "<<"
      Enabled         =   0   'False
      Height          =   495
      Left            =   3840
      TabIndex        =   7
      Top             =   1800
      Width           =   1095
   End
   Begin VB.CommandButton cmdCipher
      Caption         =   ">>"
      Enabled         =   0   'False
      Height          =   495
      Left            =   3840
      TabIndex        =   6
      Top             =   960
      Width           =   1095
   End
   Begin VB.TextBox txtPassword
      Height          =   285
      Left            =   3480
      TabIndex        =   5
      Top             =   360
      Width           =   1815
   End
   Begin VB.TextBox txtCipher
      Height          =   2295
      Left            =   5400
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   0
      Width           =   3375
   End
   Begin VB.TextBox txtPlain
      Height          =   2295
      Left            =   0
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "Form1.frx":0000
      Top             =   0
      Width           =   3375
   End
   Begin VB.Label Label1
      Alignment       =   2  'Center
      Caption         =   "Password"
      Height          =   255
      Index           =   2
      Left            =   3480
      TabIndex        =   4
      Top             =   120
      Width           =   1815
   End
   Begin VB.Label Label1
      Alignment       =   2  'Center
      Caption         =   "Ciphertext"
      Height          =   255
      Index           =   1
      Left            =   5400
      TabIndex        =   3
      Top             =   2400
      Width           =   3375
   End
   Begin VB.Label Label1
      Alignment       =   2  'Center
      Caption         =   "Plaintext"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   1
      Top             =   2400
      Width           =   3375
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Encipher the text using the pasword.
Private Sub Cipher(ByVal password As String, ByVal from_text As String, to_text As String)
Const MIN_ASC = 32  ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
    ' Initialize the random number generator.
    offset = NumericPassword(password)
    Rnd -1
    Randomize offset
    ' Encipher the string.
    str_len = Len(from_text)
    For i = 1 To str_len
        ch = Asc(Mid$(from_text, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch + offset) Mod NUM_ASC)
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
End Sub
' Encipher the text using the pasword.
Private Sub Decipher(ByVal password As String, ByVal from_text As String, to_text As String)
Const MIN_ASC = 32  ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
    ' Initialize the random number generator.
    offset = NumericPassword(password)
    Rnd -1
    Randomize offset
    ' Encipher the string.
    str_len = Len(from_text)
    For i = 1 To str_len
        ch = Asc(Mid$(from_text, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch - offset) Mod NUM_ASC)
            If ch < 0 Then ch = ch + NUM_ASC
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
End Sub
' Translate a password into an offset value.
Private Function NumericPassword(ByVal password As String) As Long
Dim value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer
    str_len = Len(password)
    For i = 1 To str_len
        ' Add the next letter.
        ch = Asc(Mid$(password, i, 1))
        value = value Xor (ch * 2 ^ shift1)
        value = value Xor (ch * 2 ^ shift2)
        ' Change the shift offsets.
        shift1 = (shift1 + 7) Mod 19
        shift2 = (shift2 + 13) Mod 23
    Next i
    NumericPassword = value
End Function
Private Sub cmdCipher_Click()
Dim cipher_text As String
    Cipher txtPassword.Text, txtPlain.Text, cipher_text
    txtCipher.Text = cipher_text
End Sub
Private Sub cmdDecipher_Click()
Dim plain_text As String
    Decipher txtPassword.Text, txtCipher.Text, plain_text
    txtPlain.Text = plain_text
End Sub
Private Sub txtPassword_Change()
    If Len(txtPassword.Text) > 0 Then
        cmdCipher.Enabled = True
        cmdDecipher.Enabled = True
    Else
        cmdCipher.Enabled = False
        cmdDecipher.Enabled = False
    End If
End Sub